home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / SHOOT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  1KB  |  41 lines
  1. PROCEDURE shoot(nvar: integer; VAR v: gln2array; delv: gln2array;
  2.       n2: integer; x1,x2,eps,h1,hmin: real; VAR f,dv: glnvar);
  3. (* Programs using routine SHOOT must define the types
  4. TYPE
  5.    gln2array = ARRAY [1..n2] OF real;
  6.    glnvar = ARRAY [1..nvar] OF real;
  7.    gln2byn2 = ARRAY [1..n2,1..n2] OF real;
  8.    glinvar = ARRAY [1..nvar] OF integer;
  9.    glnpbynp = gln2byn2;
  10. in the main routine, and set the variable kmax of ODEINT to zero. *)
  11. VAR
  12.    nok,nbad,iv,i: integer;
  13.    sav,det: real;
  14.    y: glnvar;
  15.    dfdv: gln2byn2;
  16.    indx: glinvar;
  17. BEGIN
  18.    load(x1,v,y);
  19.    odeint(y,nvar,x1,x2,eps,h1,hmin,nok,nbad);
  20.    score(x2,y,f);
  21.    FOR iv := 1 TO n2 DO BEGIN
  22.       sav := v[iv];
  23.       v[iv] := v[iv]+delv[iv];
  24.       load(x1,v,y);
  25.       odeint(y,nvar,x1,x2,eps,h1,hmin,nok,nbad);
  26.       score(x2,y,dv);
  27.       FOR i := 1 TO n2 DO BEGIN
  28.          dfdv[i,iv] := (dv[i]-f[i])/delv[iv]
  29.       END;
  30.       v[iv] := sav
  31.    END;
  32.    FOR iv := 1 TO n2 DO BEGIN
  33.       dv[iv] := -f[iv]
  34.    END;
  35.    ludcmp(dfdv,n2,nvar,indx,det);
  36.    lubksb(dfdv,n2,nvar,indx,dv);
  37.    FOR iv := 1 TO n2 DO BEGIN
  38.       v[iv] := v[iv] + dv[iv]
  39.    END
  40. END;
  41.